Usenet 1993 July/InfoMagic USENET CD-ROM July 1993.ISO/sources/misc/volume8/pcmail/part03

Text File | 1989-11-03 | 48.3 KB | 1,335 lines

Newsgroups: comp.sources.misc
subject: v08i111: pcmail part 03 of 08
From: [e-mail] (Brandon S. Allbery - comp.sources.misc)
Reply-To: [e-mail] (Croaker the Physician)

Posting-number: Volume 8, Issue 111
Submitted-by: [e-mail] (Croaker the Physician)
Archive-name: pcmail/part03

#--------------------------------CUT HERE-------------------------------------
#! /bin/sh
#
# This is a shell archive.  Save this into a file, edit it
# and delete all lines above this comment.  Then give this
# file to sh by executing the command "sh file".  The files
# will be extracted into the current directory owned by
# you with default permissions.
#
# The files contained herein are:
#
# -rw-r--r--  1 markl        5212 Oct 30 15:47 nntp.h
# -rw-r--r--  1 markl        8697 Oct 30 15:47 nntp_slave.c
# -rw-rw-r--  1 markl       21473 Nov  1 13:33 pcmail.el
# -rw-rw-r--  1 markl        5839 Oct 30 15:47 pcmaildate.el
# -rw-rw-r--  1 markl        4209 Oct 30 15:47 pcmaildrop.el
#
echo 'x - nntp.h'
if test -f nntp.h; then echo 'shar: not overwriting nntp.h'; else
sed 's/^X//' << '________This_Is_The_END________' > nntp.h
X/*
X GNU-EMACS PCMAIL mail reader support utility
X
X Written by Mark L. Lambert
X Architecture Group, Network Products Division
X Oracle Corporation
X 20 Davis Dr,
X Belmont CA, 94002
X
X internet: [e-mail] or [e-mail]
X UUCP:     {hplabs,uunet,apple}!oracle!markl
X
XCopyright (C) 1989 Mark L. Lambert
X
XThis file is not officially part of GNU Emacs, but is being
Xdonated to the Free Software Foundation.  As such, it is
Xsubject to the standard GNU-Emacs General Public License,
Xreferred to below.
X
XGNU Emacs is distributed in the hope that it will be useful,
Xbut WITHOUT ANY WARRANTY.  No author or distributor
Xaccepts responsibility to anyone for the consequences of using it
Xor for whether it serves any particular purpose or works at all,
Xunless he says so in writing.  Refer to the GNU Emacs General Public
XLicense for full details.
X
XEveryone is granted permission to copy, modify and redistribute
XGNU Emacs, but only under the conditions described in the
XGNU Emacs General Public License.   A copy of this license is
Xsupposed to have been given to you along with GNU Emacs so you
Xcan know your rights and responsibilities.  It should be in a
Xfile named COPYING.  Among other things, the copyright notice
Xand this notice must be preserved on all copies.
X*/
X
X/*
X * Response codes for NNTP server
X *
X * @(#)response_codes.h 1.6     (Berkeley) 2/6/86
X *
X * First digit:
X *
X *      1xx     Informative message
X *      2xx     Command ok
X *      3xx     Command ok so far, continue
X *      4xx     Command was correct, but couldn't be performed
X *              for some specified reason.
X *      5xx     Command unimplemented, incorrect, or a
X *              program error has occured.
X *
X * Second digit:
X *
X *      x0x     Connection, setup, miscellaneous
X *      x1x     Newsgroup selection
X *      x2x     Article selection
X *      x3x     Distribution
X *      x4x     Posting
X */
X
X#define CHAR_INF        '1'
X#define CHAR_OK         '2'
X#define CHAR_CONT       '3'
X#define CHAR_ERR        '4'
X#define CHAR_FATAL      '5'
X
X#define INF_HELP        100     /* Help text on way */
X#define INF_DEBUG       199     /* Debug output */
X
X#define OK_CANPOST      200     /* Hello; you can post */
X#define OK_NOPOST       201     /* Hello; you can't post */
X#define OK_SLAVE        202     /* Slave status noted */
X#define OK_GOODBYE      205     /* Closing connection */
X#define OK_GROUP        211     /* Group selected */
X#define OK_GROUPS       215     /* Newsgroups follow */
X#define OK_ARTICLE      220     /* Article (head & body) follows */
X#define OK_HEAD         221     /* Head follows */
X#define OK_BODY         222     /* Body follows */
X#define OK_NOTEXT       223     /* No text sent -- stat, next, last */
X#define OK_NEWNEWS      230     /* New articles by message-id follow */
X#define OK_NEWGROUPS    231     /* New newsgroups follow */
X#define OK_XFERED       235     /* Article transferred successfully */
X#define OK_POSTED       240     /* Article posted successfully */
X
X#define CONT_XFER       335     /* Continue to send article */
X#define CONT_POST       340     /* Continue to post article */
X
X#define ERR_GOODBYE     400     /* Have to hang up for some reason */
X#define ERR_NOGROUP     411     /* No such newsgroup */
X#define ERR_NCING       412     /* Not currently in newsgroup */
X#define ERR_NOCRNT      420     /* No current article selected */
X#define ERR_NONEXT      421     /* No next article in this group */
X#define ERR_NOPREV      422     /* No previous article in this group */
X#define ERR_NOARTIG     423     /* No such article in this group */
X#define ERR_NOART       430     /* No such article at all */
X#define ERR_GOTIT       435     /* Already got that article, don't send */
X#define ERR_XFERFAIL    436     /* Transfer failed */
X#define ERR_XFERRJCT    437     /* Article rejected, don't resend */
X#define ERR_NOPOST      440     /* Posting not allowed */
X#define ERR_POSTFAIL    441     /* Posting failed */
X
X#define ERR_COMMAND     500     /* Command not recognized */
X#define ERR_CMDSYN      501     /* Command syntax error */
X#define ERR_ACCESS      502     /* Access to server denied */
X#define ERR_FAULT       503     /* Program fault, command not performed */
X
X/* nntp program interface error codes */
X#define NN_ERR_OS_RANGE 2
X#define NN_ERR_NOERR    0
X#define NN_ERR_IO       1
X#define NN_ERR_SKT      2
X#define NN_ERR_CONN     3
X#define NN_ERR_NOSVC    4
X#define NN_ERR_NOHOST   5
X#define NN_ERR_RESET    6
X#define NN_ERR_PROTO    7
X
Xint nntp_out(), nntp_open_connection(), nntp_list_end_p(),
X    nntp_in(), nntp_command();
Xvoid nntp_close();
Xchar *nntp_errstring();
X
X#define TRUE 1
X#define FALSE (!TRUE)
X#define OK 0
X#define ERROR (-1)
X
X#define nntp_current_reply(nnp) ((nnp)->nn_reply)
X#define nntp_current_reply_code(nnp) ((nnp)->nn_reply_code)
X#define nntp_end_list(nnp) (nntp_out((nnp), "."))
X#define nntp_errno(nnp) ((nnp)->nn_error)
X#define nntp_os_errorp(nnp) (nntp_errno((nnp)) <= NN_ERR_OS_RANGE)
X
Xtypedef struct {
X    char nn_inbuf[512];
X    char *nn_old_data_begin;
X    char *nn_new_data_begin;
X    char nn_reply[512];
X    char nn_outbuf[512];
X    int nn_reply_code;
X    int nn_skt;
X    int nn_error;
X    int nn_nbytes;
X} Nntp_stream;
________This_Is_The_END________
if test `wc -c < nntp.h` -ne 5212; then
    echo 'shar: nntp.h was damaged during transit (should have been 5212 bytes)'
fi
fi        ; : end of overwriting check
echo 'x - nntp_slave.c'
if test -f nntp_slave.c; then echo 'shar: not overwriting nntp_slave.c'; else
sed 's/^X//' << '________This_Is_The_END________' > nntp_slave.c
X/*
X GNU-EMACS PCMAIL mail reader support utility
X
X Written by Mark L. Lambert
X Architecture Group, Network Products Division
X Oracle Corporation
X 20 Davis Dr,
X Belmont CA, 94002
X
X internet: [e-mail] or [e-mail]
X UUCP:     {hplabs,uunet,apple}!oracle!markl
X
XCopyright (C) 1989 Mark L. Lambert
X
XThis file is not officially part of GNU Emacs, but is being
Xdonated to the Free Software Foundation.  As such, it is
Xsubject to the standard GNU-Emacs General Public License,
Xreferred to below.
X
XGNU Emacs is distributed in the hope that it will be useful,
Xbut WITHOUT ANY WARRANTY.  No author or distributor
Xaccepts responsibility to anyone for the consequences of using it
Xor for whether it serves any particular purpose or works at all,
Xunless he says so in writing.  Refer to the GNU Emacs General Public
XLicense for full details.
X
XEveryone is granted permission to copy, modify and redistribute
XGNU Emacs, but only under the conditions described in the
XGNU Emacs General Public License.   A copy of this license is
Xsupposed to have been given to you along with GNU Emacs so you
Xcan know your rights and responsibilities.  It should be in a
Xfile named COPYING.  Among other things, the copyright notice
Xand this notice must be preserved on all copies.
X
Xnntp_slave.  A very simple and primitive NNTP client.  Called as:
X
X    nntp_slave <server> <newsgroup name> <output file> <control file>
X
XThe program connects to SERVER and retrieves into OUTPUT-FILE all messages
Xin NEWSGROUP-NAME with article numbers greater than the article number in
XCONTROL-FILE.  The messages are separated by the delimiting sequence
XSLV_ART_DELIM, #defined below.
X
XEventually, this should probably be replaced with Emacs-Lisp NNTP code.
XThis stuff just happened to be already lying around...
X*/
X
X#include <stdio.h>
X#include "nntp.h"
X#include <errno.h>
X
X#define SLV_ART_DELIM "\014\n"
X#define SLV_M_NAME 50
X#define SLV_M_PATH 256
X#define SLV_M_BUF 512
X#define MAX(x, y) ((x) > (y) ? (x) : (y))
X
Xvoid slv_err_report(), slv_osd_bboard();
Xchar *strerror();
X
Xvoid main(argc, argv)
X
Xint argc;
Xchar *argv[];
X{
X  char server[SLV_M_NAME], bbname[SLV_M_NAME], ctlname[SLV_M_PATH],
X       outfile[SLV_M_PATH];
X  int slv_cmdline(), slv_new_articles(), ret;
X  Nntp_stream nnp;
X
X  if(slv_cmdline(argc, argv, server, bbname, outfile, ctlname) == ERROR)
X    exit(1);
X  if(nntp_open_connection(server, &nnp) == ERROR)
X  {
X    slv_err_report(&nnp);
X    exit(1);
X  }
X  ret = slv_new_articles(&nnp, bbname, outfile, ctlname);
X  nntp_close(&nnp);
X  (ret == ERROR) ? exit(1) : exit(0);
X}
X
Xint slv_cmdline(argc, argv, server, bbname, outfile, ctlname)
X
Xint argc;
Xchar *argv[];
Xchar *server;
Xchar *bbname;
Xchar *outfile;
Xchar *ctlname;
X{
X  if(argc != 5)
X  {
X    printf("nntp-slave: usage is nntp_slave <server-name> <newsgroup-name> <outfile> <controlfile>\n");
X    return(ERROR);
X  }
X  strncpy(server, argv[1], SLV_M_NAME);
X  strncpy(bbname, argv[2], SLV_M_NAME);
X  strncpy(outfile, argv[3], SLV_M_PATH);
X  strncpy(ctlname, argv[4], SLV_M_PATH);
X  return(OK);
X}
X
Xint slv_new_articles(nnp, bbname, outfile, ctl_path)
X
XNntp_stream *nnp;
Xchar *bbname;
Xchar *outfile;
Xchar *ctl_path;
X{
X  char ctlinfo[SLV_M_BUF], ctlbboard[SLV_M_NAME],
X       cmdbuf[SLV_M_BUF], junk2[SLV_M_NAME], ctl_path_new[SLV_M_PATH];
X  int slv_deliver(), ctllast = 0, ret, bb_first, bb_last, junk, newlast,
X      slv_open_ctl_outfile();
X  FILE *fin = NULL, *fout = NULL;
X
X  /* open control file, read all information, write out all but desired
X     bboard, store desired bboard information (last article read) */
X
X  (void) sprintf(ctl_path_new, "%snew", ctl_path);
X  fin = fopen(ctl_path, "r");
X  if(slv_open_ctl_outfile(ctl_path_new, &fout) == ERROR)
X    goto EndComm;
X  if(fin)
X  {
X    while(fgets(ctlinfo, sizeof(ctlinfo), fin))
X    {
X      if(sscanf(ctlinfo, "%s %d", ctlbboard, &junk) != 2)
X      {
X    printf("nntp-slave: Illegal format in newsgroup control file\n");
X    goto EndComm;
X      }
X      if(strcmp(ctlbboard, bbname) != 0)
X      {
X        fputs(ctlinfo, fout);
X    if(ferror(fout))
X    {
X      printf("nntp-slave: Newsgroup control file write error (%s)\n",
X         strerror(errno));
X      goto EndComm;
X    }
X      }
X      else
X        ctllast = junk;
X    }
X    if(fclose(fin) == ERROR)
X    {
X      printf("nntp-slave: Newsgroup control file close error (%s)\n",
X         strerror(errno));
X      fin = NULL;
X      goto EndComm;
X    }
X  }
X  /* if newsgroup is already subscribed to, ctllast is last article number
X     read, otherwise it is zero.  Set group to desired bboard and read
X     information.  If group exists, set target article count to be max
X     articles on group, and set start article count to be
X     MAX(ctllast, group-first).  Get articles, update control file, and bung
X     out */
X  (void) sprintf(cmdbuf, "group %s", bbname);
X  if((ret = nntp_command(nnp, cmdbuf)) == ERROR)
X  {
X    slv_err_report(nnp);
X    goto EndComm;
X  }
X  else if(ret == 0)
X  {
X    if(nntp_current_reply_code(nnp) == ERR_NOGROUP)
X      printf("nntp-slave: No newsgroup named \"%s\"\n", bbname);
X    else
X      printf("nntp-slave: Unexpected response \"%s\"",
X         nntp_current_reply(nnp));
X    goto EndComm;
X  }
X  if(sscanf(nntp_current_reply(nnp), "%d %d %d %d %s", &junk, &junk,
X        &bb_first, &bb_last, junk2) != 5)
X  {
X    printf("nntp-slave: Protocol error in GROUP reply \"%s\"\n",
X       nntp_current_reply(nnp));
X    goto EndComm;
X  }
X
X  /* figure the first article to read: if we've never seen this bboard,
X     start with article 1 or 20 less than the limit, whatever is greater.
X     Otherwise start with the first article the server knows about or
X     the control file's last article, whatever is greater */
X  if(ctllast == 0) ctllast = MAX(1, bb_last - 20);
X  else ctllast = MAX(ctllast, bb_first);
X
X  ret = slv_deliver(nnp, bbname, ctllast, bb_last, &newlast, outfile);
X  (void) fprintf(fout, "%s %d\n", bbname, newlast);
X  if(ferror(fout))
X  {
X    printf("nntp-slave: Newsgroup control file write error (%s)\n",
X       strerror(errno));
X    goto EndComm;
X  }
X  if(fclose(fout) == ERROR)
X  {
X    printf("nntp-slave: Newsgroup control file close error (%s)\n",
X       strerror(errno));
X    fout = NULL;
X    goto EndComm;
X  }
X  if(rename(ctl_path_new, ctl_path) == ERROR)
X  {
X    printf("nntp-slave: Newsgroup control file rename error (%s)\n",
X       strerror(errno));
X    goto EndComm;
X  }
X  return(ret);
X
X EndComm:
X  if(fout) (void) fclose(fout);
X  if(fin) (void) fclose(fin);
X  return(ERROR);
X}
X
Xint slv_deliver(nnp, bbname, first, last, newlast, inbox_path)
X
XNntp_stream *nnp;
Xchar *bbname;
Xint first, last, *newlast;
Xchar *inbox_path;
X{
X  FILE *fout = NULL;
X  char cmdbuf[SLV_M_BUF];
X  int ret;
X
X  if(! (fout = fopen(inbox_path, "w")))
X  {
X    printf("nntp-slave: %s open error (%s)\n", inbox_path, strerror(errno));
X    goto EndComm;
X  }
X  for(*newlast = first; *newlast <= last; ++(*newlast))
X  {
X    (void) sprintf(cmdbuf, "article %d", *newlast);
X    if((ret = nntp_command(nnp, cmdbuf)) == ERROR)
X    {
X      slv_err_report(nnp);
X      goto EndComm;
X    }
X    else if(nntp_current_reply_code(nnp) == ERR_NOARTIG ||
X        nntp_current_reply_code(nnp) == ERR_NOART)
X      continue;                                     /* skip missing articles */
X    else if(nntp_current_reply_code(nnp) != OK_ARTICLE)
X    {
X      printf("nntp-slave: Unexpected response \"%s\"",
X         nntp_current_reply(nnp));
X      goto EndComm;
X    }
X    (void) fputs(SLV_ART_DELIM, fout);
X    if(ferror(fout))
X    {
X      printf("nntp-slave: Inbox file write error (%s)\n", strerror(errno));
X      goto EndComm;
X    }
X    while((ret = nntp_list_end_p(nnp)) == 0)
X    {
X      (void) fprintf(fout, "%s\n", nntp_current_reply(nnp));
X      if(ferror(fout))
X      {
X    printf("nntp_slave: Inbox file write error (%s)\n", strerror(errno));
X    goto EndComm;
X      }
X    }
X    if(ret == ERROR)
X    {
X      slv_err_report(nnp);
X      goto EndComm;
X    }
X  }
X  if(fclose(fout) == ERROR)
X  {
X    fout = NULL;
X    printf("nntp_slave: Error closing inbox file (%s)\n", strerror(errno));
X    goto EndComm;
X  }
X  return(OK);
X
X EndComm:
X  if(fout) (void) fclose(fout);
X  return(ERROR);
X}
X
Xvoid slv_err_report(nnp)
Xregister Nntp_stream *nnp;
X{
X  printf("nntp-slave: NNTP error (%s)\n", nntp_errstring(nnp));
X  if(nntp_os_errorp(nnp))
X    printf("nntp-slave: OS error %d (%s)\n", errno, strerror(errno));
X}
X
Xint slv_open_ctl_outfile(ctl_path, fout)
X
Xchar *ctl_path;
XFILE **fout;
X{
X  if(! (*fout = fopen(ctl_path, "w")))
X  {
X    printf("nntp-slave: Newsgroup control file open error (%s)\n",
X       strerror(errno));
X    return(ERROR);
X  }
X  return(OK);
X}
X
X/* system-dependent stuff * follows */
X
Xextern char *sys_errlist[];
X
Xchar *strerror(n)
Xint n;
X{
X  return(sys_errlist[errno]);
X}
________This_Is_The_END________
if test `wc -c < nntp_slave.c` -ne 8697; then
    echo 'shar: nntp_slave.c was damaged during transit (should have been 8697 bytes)'
fi
fi        ; : end of overwriting check
echo 'x - pcmail.el'
if test -f pcmail.el; then echo 'shar: not overwriting pcmail.el'; else
sed 's/^X//' << '________This_Is_The_END________' > pcmail.el
X;;;; GNU-EMACS PCMAIL mail reader
X
X;;  Written by Mark L. Lambert
X;;  Architecture Group, Network Products Division
X;;  Oracle Corporation
X;;  20 Davis Dr,
X;;  Belmont CA, 94002
X;;
X;;  internet: [e-mail] or [e-mail]
X;;  UUCP:     {hplabs,uunet,apple}!oracle!markl
X
X;; Copyright (C) 1989 Mark L. Lambert
X
X;; This file is not officially part of GNU Emacs, but is being
X;; donated to the Free Software Foundation.  As such, it is
X;; subject to the standard GNU-Emacs General Public License,
X;; referred to below.
X
X;; GNU Emacs is distributed in the hope that it will be useful,
X;; but WITHOUT ANY WARRANTY.  No author or distributor
X;; accepts responsibility to anyone for the consequences of using it
X;; or for whether it serves any particular purpose or works at all,
X;; unless he says so in writing.  Refer to the GNU Emacs General Public
X;; License for full details.
X
X;; Everyone is granted permission to copy, modify and redistribute
X;; GNU Emacs, but only under the conditions described in the
X;; GNU Emacs General Public License.   A copy of this license is
X;; supposed to have been given to you along with GNU Emacs so you
X;; can know your rights and responsibilities.  It should be in a
X;; file named COPYING.  Among other things, the copyright notice
X;; and this notice must be preserved on all copies.
X
X;;;; required pcmail elisp files.  Order is significant.
X
X(require 'pcmailsysdep)
X(require 'pcmailbabyl)
X(require 'pcmaildrop)
X(require 'pcmailfolder)
X(require 'pcmaillist)
X(require 'pcmailattr)
X(require 'pcmailmove)
X(require 'pcmaildate)
X(require 'pcmailsub)
X(require 'mail-utils)
X
X;;;; global variables
X
X;;; system-defined variables
X
X(defconst pcmail-version "4.0"
X  "Mail reader version.")
X
X(defvar pcmail-directory (get 'pcmail-mail-environment 'mail-directory)
X  "The directory in which all folders are stored.")
X
X(defvar pcmail-time-zone (get 'pcmail-mail-environment 'time-zone)
X  "The local time zone, in three character format, i.e. \"PST\".")
X
X;;; user-defined config parameters
X
X(defvar pcmail-nntp-host-name "newshost"
X  "*The name of your local NNTP server.  Only interesting if you are using
XThe nntp-mail-drop or nntp-file-mail-drop mail drop types, in which case it
Xmust be defined.")
X
X(defvar pcmail-expiration-hook
X  '(lambda (n) (pcmail-set-attribute n "deleted" t))
X  "*A hook expression that is applied to messages with the \"timely\"
Xattribute when current date is later than message's \"expires:\" field.")
X
X(defvar pcmail-progress-interval 10
X  "*When performing time-intensive tasks like message counting or filtering,
Xa progress message is displayed every pcmail-progress-interval messages, with
Xthe total number of messages processed displayed upon completion of the task.")
X
X(defvar pcmail-uninteresting-fields-list
X  '("via" "mail-from" "origin" "status" "received" "message-id" "expires"
X      "resent-message-id" "summary-line" "return-path" "priority")
X  "*Non-nil means prune from the message header all fields in this list.
XView the unpruned header with the \\[pcmail-toggle-message-header] command.")
X
X(defvar pcmail-wastebasket-folder "wastebasket"
X  "*The wastebasket folder name.  The wastebasket folder is a useful place
Xto copy messages that aren't really wanted anymore.
XIf pcmail-wastebasket-on-expunge is non-NIL, expunged messages are placed
Xhere before removal from their folder.")
X
X(defvar pcmail-wastebasket-on-expunge nil
X  "*Non-nil means copy deleted messages to the wastebasket before expunging.
XThis can be very time-consuming.")
X
X(defvar pcmail-expunge-on-save t
X  "*Non-nil means expunge folders before saving them.")
X
X(defvar pcmail-save-on-quit t
X  "*Non-nil means save all folders upon exit from the mail reader.")
X
X(defvar pcmail-delete-on-archive nil
X  "*Non-nil means automatically delete a message that is archived to a file.")
X
X(defvar pcmail-delete-on-copy nil
X  "*Non-nil means automatically delete a message that is copied to another
Xfolder.")
X
X(defvar pcmail-delete-on-print nil
X  "*Non-nil means automatically delete a message that is sent to a printer.")
X
X(defvar pcmail-printer-name (get 'pcmail-mail-environment 'printer)
X  "*The printer that the \\[pcmail-print-message] command sends messages to.")
X
X(defvar pcmail-pigeonhole-hook nil
X  "*If non-NIL, a hook expression applied to each new message in a mail drop.
XThe hook expression is passed the new message's absolute message number.")
X
X(defvar pcmail-interesting-hook
X  '(lambda (n) (and (not (pcmail-has-attribute-p n "deleted"))
X            (< (pcmail-message-priority n) 5)))
X  "*If non-NIL, a lambda expression which is applied to a message number.
XIf the expression returns non-NIL, the message is interesting, otherwise it
Xis not.")
X
X(defvar pcmail-yank-message-on-reply nil
X  "*If non-NIL, the \\[pcmail-answer-message\\] command will automatically
Xinsert a copy of the replied-to message in the message reply.")
X
X(defvar pcmail-yank-prefix nil
X  "*If a string, any message inserted into the message composition buffer
Xwill have that string placed at the beginning of each non-blank line.")
X
X(defvar pcmail-highlight-forwarded-message nil
X  "*Non-NIL means place a \"begin forwarded message\" line before the
Xforwarded message and a \"end forwarded message\" line after it.  Messages
Xare forwarded using the \\[pcmail-forward-message\\] command.")
X
X(defvar pcmail-default-filter-name "all"
X  "*Name of the filter to be used when you first enter a folder.
XDefault value is the filter named \"all\", which contains all messages
Xin the folder.")
X
X(defvar pcmail-summary-format "%d  %25f  %s"
X  "*The format string used to format summary lines.
XThe following percent-constructs are recognized:
X
X   %b:  replace with the contents of the bcc: field
X   %c:  replace with the contents of the cc: field
X   %C:  replace with the message's character count
X   %d:  replace with the contents of the date: field, dd-mon-yy
X   %f:  replace with the contents of the from: field
X   %l:  replace with the message's line count
X   %m:  replace with the contents of the message-id: field
X   %s:  replace with the contents of the subject: field
X   %t:  replace with the contents of the to: field
X
XAll directive modifications (field width, justification, etc) are recognized
Xand work as the emacs-lisp format function.
XDefault value of pcmail-summary-format places date, followed by from and
Xsubject fields, in a summary line.")
X
X(defvar pcmail-date-format "%d-%m-%y"
X  "*The format string used to format dates.
XThe following percent-constructs are recognized:
X
X   %d:  replace with the day of the month
X   %n:  replace with the number of the month
X   %m:  replace with the first three letters of the month
X   %M:  replace with the full name of the month
X   %y:  replace with the last two digits of the year
X   %Y:  replace with the full year
X
XAll directive modifications (field width, justification, etc) are recognized
Xand work as the emacs-lisp format function.
XDefault value of pcmail-date-format is \"%d-%m-%y\", which creates a
Xdate of the form dd-mmm-yy.")
X
X(defvar pcmail-folder-mode-line-format
X  "Folder: %-18f (%eMessage %s/%S%n: %a) %p"
X  "*The format string used to format a folder's mode line.
XThe following percent-constructs are recognized:
X
X   %a:  replace with the current message's attribute list, or \"[none]\",
X        if the message has no attributes
X   %c:  replace with the current message's character count
X   %e:  if current message is being edited, replace with \"Editing\"
X   %E:  if current message is timely, replace with expiration date
X   %f:  replace with the current folder name
X   %l:  replace with the current message's line count
X   %n:  if the current subset does not comprise the entire folder, or the
X        current message's number os not the same as its absolute number,
X        replace with the message's absolute number and the total number of
X        messages in the folder in the form \"[<curr>/<total>]\"
X   %p:  replace with the current message's priority if the priority
X        number is greater than 1.
X   %s:  replace with the current message's number
X   %S:  replace with the number of messages in the current subset
X
XAll directive modifications (field width, justification, etc) are recognized
Xand work as the emacs-lisp format function.")
X
X(defvar pcmail-resummarize-folder-on-change nil
X  "*If non-NIL, resummarize a folder with an existing summary every time
Xthe folder changes.  Changes are defined as a change in the number of messages
Xin the folder or a change in their order.  Default value is NIL.")
X
X;;;; mail reader entry point
X
X(defun pcmail (&optional no-hooks)
X  "Read and edit mail using the Pcmail mail reader.
X
XPcmail operates on Babyl-format mail files.  Pcmail (as does RMAIL)
Xtreats the \"unseen\" label as a Babyl-defined attribute rather than
Xthe user-defined attribute it should be.  Pcmail conforms to the Babyl
Xspecification in all other respects.
X
XThere are a number of configuration variables that you can set to
Xcustomize the mail reader.  A list of them follows this documentation.
XUse a lambda-expression set to \"pcmail-hook\" in order to set these
Xvariables upon entry into the mail reader.  Type \\[describe-mode]
Xafter the mail reader has started; this will get you a list of mode
Xcommands.  Typing \\[describe-function] with one of the function names
Xlisted in the mode documentation will give more detailed documentation
Xon what the particular function does.
X
XFollowing is a list of user-settable configuration variables.  Type
X \\[describe-variable] to get a particular variable's description.
X
Xpcmail-expunge-on-save        pcmail-yank-original-on-reply
Xpcmail-delete-on-archive        pcmail-delete-on-copy
Xpcmail-delete-on-print         pcmail-pigeonhole-hook
Xpcmail-printer-name        pcmail-highlight-forwarded-message
Xpcmail-wastebasket-folder    pcmail-yank-prefix
Xpcmail-default-filter-name      pcmail-uninteresting-fields-list
Xpcmail-progess-interval         pcmail-interesting-hook
Xpcmail-expiration-hook        pcmail-wastebasket-on-expunge
Xpcmail-date-format              pcmail-summary-format
Xpcmail-nntp-host-name
X
Xmail-header-separator        rmail-dont-reply-to-names
Xmail-use-rfc822            mail-aliases
Xmail-yank-ignored-headers    mail-self-blind
Xmail-default-reply-to           mail-archive-file-name
Xmail-setup-hook
X
XTyping \\[pcmail] causes the hook variable \"pcmail-hook\" to
Xbe evaluated unless a prefix argument has been supplied.  The hook
Xvariable \"pcmail-exit-hook\" is evaluated upon exit from the mail reader
Xvia the \\[pcmail-quit] command."
X  (interactive "P")
X  (or no-hooks (run-hooks 'pcmail-hook))
X  (pcmail-maybe-init)
X  (pcmail-get-mail pcmail-primary-folder-name))
X
X;;; maybe create mail directory, folder list, and primary folder.
X(defun pcmail-maybe-init ()
X  "Create mail directory and primary folder as necessary.
XArgs: none"
X  (and (get 'pcmail-mail-environment 'send-mail-function)
X       (setq send-mail-function
X         (get 'pcmail-mail-environment 'send-mail-function)))
X  (cond ((not (file-directory-p pcmail-directory))
X     (or (yes-or-no-p
X          (format "Pcmail mail directory \"%s\" does not exist.  Create? "
X              pcmail-directory))
X       (error "Aborted."))
X     (funcall (get 'pcmail-mail-environment 'create-mail-directory-fn))
X     (pcmail-create-folder-list-file)))
X  (pcmail-load-folder-information)
X  (cond ((not (pcmail-find-folder pcmail-primary-folder-name))
X     (or (yes-or-no-p
X          (format "Pcmail primary folder \"%s\" not found.  Create? "
X              pcmail-primary-folder-name))
X         (error "Aborted."))
X     (pcmail-create-folder pcmail-primary-folder-name
X                   (get 'pcmail-mail-environment
X                    'default-mail-drop-list)))))
X
X;;; mail reader exit point
X
X(defun pcmail-quit (no-hooks)
X  "Exit the mail reader.
XArgs: none.
X  Exit the mail reader in an orderly manner.  If pcmail-save-on-quit is
Xnon-NIL, save all folders first.  Evaluate the hook variable
Xpcmail-exit-hook unless a prefix argument was supplied."
X  (interactive "P")
X  (let ((cb (current-buffer)))
X
X    ; if the wastebasket exists, open it up so its messages get counted,
X    ; expired, and expunged correctly in the following save code
X    (and (pcmail-find-folder pcmail-wastebasket-folder)
X     (save-excursion
X       (pcmail-open-folder pcmail-wastebasket-folder)))
X    (and pcmail-save-on-quit
X     (mapcar
X      '(lambda (m)
X         (cond ((and (pcmail-folder-buffer-name m)
X             (get-buffer (pcmail-folder-buffer-name m)))
X            (pcmail-save-folder m)
X            (bury-buffer (pcmail-folder-buffer-name m)))))
X      (pcmail-all-folders)))
X    (let ((nmsgs))
X      (and (pcmail-find-folder pcmail-wastebasket-folder)
X       (> (setq nmsgs (pcmail-nmessages pcmail-wastebasket-folder)) 0)
X       (progn (message "%d message%s in the wastebasket"
X               nmsgs (pcmail-s-ending nmsgs))
X          (sit-for 2))))
X    (save-excursion
X      (pcmail-open-folder-list)
X      (pcmail-save-buffer)
X      (bury-buffer (current-buffer)))
X    (or no-hooks (run-hooks 'pcmail-exit-hook))
X
X    ;and make sure the folder current at quit time is displayed now
X    ; (pcmail-save-folder changes the current buffer)
X    (switch-to-buffer cb)
X    (call-interactively 'switch-to-buffer)))
X
X;;;; autoloads for edit, mail, summary, and output commands
X
X(autoload 'pcmail-mail "pcmailmail")
X(autoload 'pcmail-answer-message "pcmailmail")
X(autoload 'pcmail-forward-message "pcmailmail")
X(autoload 'pcmail-edit-message "pcmailedit")
X(autoload 'pcmail-archive-message "pcmailout")
X(autoload 'pcmail-print-message "pcmailout")
X(autoload 'pcmail-copy-message "pcmailout")
X(autoload 'pcmail-copy-message-1 "pcmailout")
X(autoload 'pcmail-archive-subset "pcmailout")
X(autoload 'pcmail-print-subset "pcmailout")
X(autoload 'pcmail-copy-subset "pcmailout")
X(autoload 'pcmail-wastebasket-message "pcmailout")
X(autoload 'pcmail-summarize-folder "pcmailsum")
X
X;;;; random routines, used by all pc*.el files
X
X;;; minibuffer input utilities
X
X(defun pcmail-read-file-name (prompt fname &optional must-exist)
X  "Read a file name from the minibuffer.
XArgs: (prompt fname &optional must-exist)
X  Read a file name from the minibuffer, prompting with PROMPT and using
Xthe file portion of FNAME as default file, the directory portion as default
Xdirectory.  If optional MUST-EXIST is non-NIL, input must be an existing
Xfile name."
X  (expand-file-name
X   (read-file-name (concat prompt
X               (if fname (concat "(default " fname ") ") ""))
X           (and fname (file-name-directory fname))
X           fname
X           must-exist)))
X
X;; a simple read routine to grab a file name from the minibuffer.  The function
X;; is only called when the folder buffer has been widened, so it narrows to
X;; the current message before getting input, then restores
X
X(defun pcmail-narrow-read-file-name (fname)
X  "Read a file name, narrowing the current buffer to the current message.
XArgs: (fname)
X  FNAME is the default to present to the user.  If NIL, no default is
Xpresented.  Note this is a more restrictive version of pcmail-read-file-name,
Xthat assumes a standard prompt and required file existence."
X  (save-excursion
X    (save-restriction
X      (pcmail-narrow-to-message
X       (pcmail-make-absolute pcmail-current-subset-message))
X      (pcmail-read-file-name "File name: " (expand-file-name fname) t))))
X
X(defun pcmail-read-string-default (prompt &optional default no-blanks)
X  "Read from minibuffer with optional default input.
XArgs: (prompt &optional default no-blanks)
X  Read from minibuffer, prompting with PROMPT, plus DEFAULT (if present).
XIf a default is supplied, allow input of \"\", which causes the default
Xvalue to be returned.  If \"\" is not input, the input is returned.  If
Xoptional NO-BLANKS is non-NIL, do not allow blanks in input."
X  (let ((res))
X    (cond ((and (stringp default)
X        (> (length default) 0))
X       (setq prompt (concat prompt "(default " default ") ")))
X      (t
X        (setq default nil)))
X    (cond (no-blanks
X       (setq res (read-no-blanks-input prompt "")))
X      (t
X       (setq res (read-string prompt))))
X    (cond ((string= res "")
X        (cond (default)
X          (t
X            (error "No default has been set."))))
X      (t
X        res))))
X
X(defun pcmail-completing-read (prompt table &optional default pred force-p)
X  "Completing read from minibuffer with optional default input.
XArgs: (prompt table &optional default pred force-p)
X  Read from the minibuffer using prompt PROMPT and completion list or
Xobarray TABLE.  If pred is non-NIL, input is valid only if PRED when
Xapplied to input returns non-NIL.  If FORCE-P is non-NIL, require a
Xmatch with an elt of TABLE.
XIf DEFAULT is a string, a blank string can be input, in which case the
Xreturned value will be the default.  A non-blank input will be returned as
Xa new default."
X  (let ((res) (completion-ignore-case t))
X    (cond ((and (stringp default)
X        (> (length default) 0))
X       (setq prompt (concat prompt "(default " default ") ")))
X      (t
X        (setq default nil)))
X    (cond ((string= (setq res
X              (completing-read prompt table pred force-p nil)) "")
X       (or default
X           (error "No default has been specified.")))
X      (t
X        res))))
X
X;;; random routines
X
X(defun pcmail-mode-setup (mode name keymap)
X  "Generic routine for setting up pcmail modes.
XArgs: (mode name keymap)
X  All pcmail buffers have common features, which this routine sets up.  MODE
Xis the buffer's mode symbol, NAME is the buffer's mode name, and KEYMAP is
Xthe buffer's key map."
X  (kill-all-local-variables)
X  (put mode 'mode-class 'special)
X  (use-local-map keymap)
X  (set-syntax-table text-mode-syntax-table)
X  (make-local-variable 'version-control)
X  (make-local-variable 'require-final-newline)
X  (make-local-variable 'file-precious-flag)
X  (setq major-mode mode
X    mode-name name
X    local-abbrev-table text-mode-abbrev-table
X    buffer-read-only t
X    buffer-auto-save-file-name nil
X    file-precious-flag t
X    require-final-newline nil
X    version-control 'never))
X
X(defun pcmail-s-ending (n)
X  "If N is 1, return the empty string, otherwise return \"s\".
XArgs: (n)"
X  (if (= n 1) "" "s"))
X
X(defun pcmail-save-buffer (&optional buf)
X  "Save buffer object BUF, or current buffer if BUF is NIL.
XArgs: (&optional buf)
XThe only reason this function exists is that the normal save-buffer call
Xdisplays messages in the minibuffer like \"(no changes need to be saved)\",
Xwhich are distracting in the mail reader."
X  (save-excursion
X    (and buf
X     (get-buffer buf)
X     (set-buffer buf))
X    (save-restriction
X      (cond ((buffer-modified-p)
X         (widen)
X         (write-region (point-min) (point-max) buffer-file-name nil 'nomsg)
X         (clear-visited-file-modtime)
X         (set-buffer-modified-p nil))))
X    t))
X
X(defun pcmail-force-mode-line-update ()
X  "Force a mode line update.
XArgs: none"
X  (set-buffer-modified-p (buffer-modified-p)))
X
X(defun pcmail-search-entry-list (name alist)
X  "Return the list associated with NAME in ALIST.
XArgs: (name alist)"
X  (assoc name alist))
X
X(defun pcmail-in-sequence-p (thing seq)
X  "Determine if a thing is in a sequence of such things.
XArgs: (thing seq)
X  Return index of THING in SEQ if THING is EQUAL to an element in SEQ, nil
Xelse.  SEQ may be either a list or a vector."
X  (let ((i 0)
X    (found))
X    (while (and (not found) (< i (length seq)))
X      (and (equal thing (cond ((vectorp seq) (aref seq i))
X                  ((listp seq) (nth i seq))))
X       (setq found i))
X      (setq i (1+ i)))
X    found))
X
X(defun pcmail-parse-space-list (s)
X  "Turn a string of words separated by whitespace or commas into a list.
XArgs: s"
X  (let ((l) (i 0))
X    (while (string-match "\\([^ \t,]+\\)" s i)
X      (setq l (cons (substring s (match-beginning 1) (match-end 1)) l)
X        i (match-end 1)))
X    l))
X
X(defun pcmail-format-string (format alist)
X  "Format an arbitrary format string FORMAT using directive functions in ALIST.
XArgs: (format alist)
X  FORMAT is a format string with embedded printf-style format directives.
XALIST is an association list.  Each alist element's car is a format character.
XEach alist element's cadr is a function to call when the character is
Xencountered following a percent sign.  The function is passed any length or
Xjustification modifiers, together with a list of arguments which are the
Xalist element's caddr, if present.  The function may return a string or
Xa number, which is concatenated appropriately onto the formatted output
Xstring.  The output string is returned."
X  (let ((arglist) (directive) (start) (arg) (len)
X    (outformat (copy-sequence format)) (charstart))
X    (while (string-match "%\\(-?[0-9]*\\)\\([a-zA-Z]\\)" outformat start)
X      (or (setq directive (pcmail-search-entry-list
X               (substring outformat (match-beginning 2)
X                      (match-end 2))
X               alist))
X      (error "Unknown format directive in \"%s\"" outformat))
X      (setq len
X        (string-to-int (substring outformat (match-beginning 1)
X                      (match-end 1)))
X        start (match-end 0)
X        charstart (match-beginning 2)
X        arg (apply (nth 1 directive) (nthcdr 2 directive)))
X      (cond ((numberp arg)
X         (aset outformat charstart ?d))
X        (t
X         (setq arg (pcmail-justify-string arg len))
X         (aset outformat charstart ?s)))
X      (setq arglist (append arglist (list arg))))
X    (apply 'format outformat arglist)))
X
X(defun pcmail-justify-string (s len)
X  "Justify string S to LEN spaces, left if LEN is negative, right else.
XArgs: (s len)"
X  (let ((abslen (if (> len 0) len (- len))))
X    (cond ((zerop abslen)
X       s)
X      ((> (length s) abslen)
X       (substring s 0 abslen))
X      ((< len 0)
X       (concat s (make-string (- abslen (length s)) ? )))
X      ((> len 0)
X       (concat (make-string (- abslen (length s)) ? ) s)))))
X
X(provide 'pcmail)
________This_Is_The_END________
if test `wc -c < pcmail.el` -ne 21473; then
    echo 'shar: pcmail.el was damaged during transit (should have been 21473 bytes)'
fi
fi        ; : end of overwriting check
echo 'x - pcmaildate.el'
if test -f pcmaildate.el; then echo 'shar: not overwriting pcmaildate.el'; else
sed 's/^X//' << '________This_Is_The_END________' > pcmaildate.el
X;;;; GNU-EMACS PCMAIL mail reader
X
X;;  Written by Mark L. Lambert
X;;  Architecture Group, Network Products Division
X;;  Oracle Corporation
X;;  20 Davis Dr,
X;;  Belmont CA, 94002
X;;
X;;  internet: [e-mail] or [e-mail]
X;;  UUCP:     {hplabs,uunet,apple}!oracle!markl
X
X;; Copyright (C) 1989 Mark L. Lambert
X
X;; This file is not officially part of GNU Emacs, but is being
X;; donated to the Free Software Foundation.  As such, it is
X;; subject to the standard GNU-Emacs General Public License,
X;; referred to below.
X
X;; GNU Emacs is distributed in the hope that it will be useful,
X;; but WITHOUT ANY WARRANTY.  No author or distributor
X;; accepts responsibility to anyone for the consequences of using it
X;; or for whether it serves any particular purpose or works at all,
X;; unless he says so in writing.  Refer to the GNU Emacs General Public
X;; License for full details.
X
X;; Everyone is granted permission to copy, modify and redistribute
X;; GNU Emacs, but only under the conditions described in the
X;; GNU Emacs General Public License.   A copy of this license is
X;; supposed to have been given to you along with GNU Emacs so you
X;; can know your rights and responsibilities.  It should be in a
X;; file named COPYING.  Among other things, the copyright notice
X;; and this notice must be preserved on all copies.
X
X;;; global variables
X
X(defconst pcmail-month-alist
X  '(("???" 0) ("January" 0) ("February" 31) ("March" 49) ("April" 80)
X    ("May" 110) ("June" 141) ("July" 171) ("August" 202) ("September" 233)
X    ("October" 263) ("November" 294) ("December" 324))
X  "Assoc list of month names to number of days since beginning of year.")
X
X;;; date-hacking routines
X
X(defun pcmail-date-less-than-p (a b)
X  "Args: (a b)
XReturn T is message A's date is chronologically before B's, NIL else."
X  (< (pcmail-date-triple-to-ndays (pcmail-message-date a))
X     (pcmail-date-triple-to-ndays (pcmail-message-date b))))
X
X(defun pcmail-message-date (n)
X  "Return specified message's Date: field contents as a date triple.
XArgs: (n)
X  First search the pcmail-date-vector cache for a date triple.  If none is
Xfound, get message N's Date: field and bash it into a triple of the
Xform (day month year).  If no date exists, return the triple '(0 0 0)."
X  (or (aref pcmail-date-vector n)
X      (aset pcmail-date-vector n
X        (cond ((zerop n)
X           '(0 0 0))
X          (t
X            (save-excursion
X              (save-restriction
X            (let ((case-fold-search t))
X              (pcmail-narrow-to-unpruned-header n)
X              (or (pcmail-string-to-date-triple
X                (mail-fetch-field "date" nil))
X                  '(0 0 0))))))))))
X
X(defun pcmail-month-string-to-num (s)
X  "Convert a month name to its number.
XArgs: (s)"
X  (let ((found) (i 0))
X    (setq s (downcase (substring s 0 3)))
X    (mapcar '(lambda (mon)
X           (and (string= s (downcase (substring (car mon) 0 3)))
X            (setq found i))
X           (setq i (1+ i)))
X        pcmail-month-alist)
X    found))
X
X(defun pcmail-num-to-month-string (n &optional fullname)
X  "Convert a month number to its name.  Return NIL if number is not 1-12.
XArgs: (n)"
X  (cond ((< n (length pcmail-month-alist))
X     (if fullname
X         (nth 0 (nth n pcmail-month-alist))
X       (substring (nth 0 (nth n pcmail-month-alist)) 0 3)))))
X
X(defun pcmail-date-triple-to-ndays (date)
X  "Turn a date triple into an absolute number.
XArgs: (date)
X  Convert triple DATE (DAY MONTH YEAR) into a number of days by adding DAY
Xto number of days in year as of beginning of MONTH and number of days in
Xyear times YEAR.  Amount is not absolutely accurate, but good enough for
Xour purposes."
X  (+ (* 365 (nth 2 date))
X     (nth 1 (nth (nth 1 date) pcmail-month-alist))
X     (nth 0 date)))
X
X(defun pcmail-date-triple-to-string (date)
X  "Format a date triple as a string.
XArgs: (date)
X  Convert triple DATE (day month year) into a string whose format is
Xdetermined by the config variable pcmail-date-format. "
X  (pcmail-format-string
X   pcmail-date-format
X   (list (list "d" '(lambda (date) (nth 0 date)) date)
X     (list "n" '(lambda (date) (nth 1 date)) date)
X     (list "m" '(lambda (date) (pcmail-num-to-month-string (nth 1 date)))
X           date)
X     (list "M" '(lambda (date)
X              (pcmail-num-to-month-string (nth 1 date) t)) date)
X     (list "y" '(lambda (date) (nth 2 date)) date)
X     (list "Y" '(lambda (date) (+ 1900 (nth 2 date))) date))))
X
X(defun pcmail-string-to-date-triple (&optional s)
X  "Convert a date string into a date triple.
XArgs: (&optional s)
X  Convert message date: field string S to a date triple (day month year).
XIf conversion cannot be performed, return NIL.  If S is NIL, convert today's
Xdate."
X  (let ((day)
X    (month)
X    (year))
X    (or s (setq s (pcmail-todays-date)))
X    (cond ((string-match "\\([0-3]?[0-9]\\)[ \t---_]+\\([a-zA-Z][a-zA-Z][a-zA-Z]\\)[a-zA-Z]*[ \t---_]+\\([0-9][0-9][0-9]*\\)"
X             s)
X       (setq day
X         (string-to-int
X           (substring s (match-beginning 1) (match-end 1)))
X         month
X         (pcmail-month-string-to-num
X          (substring s (match-beginning 2) (match-end 2)))
X         year
X         (string-to-int
X           (substring s (match-beginning 3) (match-end 3))))))
X    (cond ((and year day month (not (zerop day)) (> year 0))
X       (and (>= year 1900)
X        (setq year (- year 1900)))
X       (list day month year)))))
X
X(defun pcmail-todays-date ()
X  "Convert today's date into an RFC822 date.
XArgs: none"
X  (let ((d (current-time-string)))
X    (and (string-match (concat "\\([a-zA-Z]+\\)[ ]+\\([a-zA-Z]+\\)[ ]+"
X                   "\\([0-9]+\\)[ ]+"
X                   "\\([0-9]+:[0-9]+:[0-9]+\\)[ ]+"
X                   "19\\([0-9][0-9]\\)")
X               d)
X     (concat (substring d (match-beginning 1) (match-end 1))
X         ", " (substring d (match-beginning 3) (match-end 3))
X         " " (substring d (match-beginning 2) (match-end 2))
X         " " (substring d (match-beginning 5) (match-end 5))
X         " " (substring d (match-beginning 4) (match-end 4))
X         " " pcmail-time-zone))))
X
X(provide 'pcmaildate)
________This_Is_The_END________
if test `wc -c < pcmaildate.el` -ne 5839; then
    echo 'shar: pcmaildate.el was damaged during transit (should have been 5839 bytes)'
fi
fi        ; : end of overwriting check
echo 'x - pcmaildrop.el'
if test -f pcmaildrop.el; then echo 'shar: not overwriting pcmaildrop.el'; else
sed 's/^X//' << '________This_Is_The_END________' > pcmaildrop.el
X;;;; GNU-EMACS PCMAIL mail reader
X
X;;  Written by Mark L. Lambert
X;;  Architecture Group, Network Products Division
X;;  Oracle Corporation
X;;  20 Davis Dr,
X;;  Belmont CA, 94002
X;;
X;;  internet: [e-mail] or [e-mail]
X;;  UUCP:     {hplabs,uunet,apple}!oracle!markl
X
X;; Copyright (C) 1989 Mark L. Lambert
X
X;; This file is not officially part of GNU Emacs, but is being
X;; donated to the Free Software Foundation.  As such, it is
X;; subject to the standard GNU-Emacs General Public License,
X;; referred to below.
X
X;; GNU Emacs is distributed in the hope that it will be useful,
X;; but WITHOUT ANY WARRANTY.  No author or distributor
X;; accepts responsibility to anyone for the consequences of using it
X;; or for whether it serves any particular purpose or works at all,
X;; unless he says so in writing.  Refer to the GNU Emacs General Public
X;; License for full details.
X
X;; Everyone is granted permission to copy, modify and redistribute
X;; GNU Emacs, but only under the conditions described in the
X;; GNU Emacs General Public License.   A copy of this license is
X;; supposed to have been given to you along with GNU Emacs so you
X;; can know your rights and responsibilities.  It should be in a
X;; file named COPYING.  Among other things, the copyright notice
X;; and this notice must be preserved on all copies.
X
X;;;; mail drop-specific functions: transfer a mail drop's contents to a
X;;;; folder buffer, transform its message headers to RFC-822 format
X
X;;;; global variables
X
X;;; system-defined globals
X
X(defvar pcmail-primary-folder-name (downcase (user-login-name))
X  "The name of your primary folder.  New mail always arrives here.")
X
X(defvar pcmail-last-mail-drop-type nil
X  "Name of last mail drop type given to the pcmail-load-mail-drop command.")
X
X;;; utility functions
X
X(defun pcmail-read-mail-drop (folder-name drop-list)
X  "Transfer new mail from mail drops to a specified folder.
XArgs: (folder-name drop-list)
X Get mail from the mail drops in drop-list, appending it to FOLDER-NAME.
XUpdate all message vectors and auto-pigeonhole messages as necessary.
XAssume folder-name is current buffer.  Leave buffer widened."
X  (let ((opoint)
X    (omsgs pcmail-total-messages))
X    (widen)
X    (setq opoint (point-max))
X    (unwind-protect
X    (mapcar 'pcmail-insert-mail-drop-contents drop-list)
X      (pcmail-set-message-vectors opoint)
X      (pcmail-set-nmessages folder-name pcmail-total-messages)
X      (pcmail-change-in-folder-list folder-name pcmail-total-messages))
X    (unwind-protect
X    (progn
X      (and pcmail-pigeonhole-hook
X           (let ((n (1+ omsgs)))
X         (while (<= n pcmail-total-messages)
X           (funcall pcmail-pigeonhole-hook n)
X           (setq n (1+ n))))))
X      (and (> pcmail-total-messages omsgs)
X       (pcmail-save-buffer)))
X    (- pcmail-total-messages omsgs)))
X
X(defun pcmail-insert-mail-drop-contents (mail-drop)
X  "Insert contents of specified mail drop into the current buffer
XArgs: (mail-drop)
X  Using MAIL-DROP's insert-function property, insert MAIL-DROP's
Xcontents into the current buffer and convert the contents to Babyl format."
X  (let ((tofile) (insert-fn) (opoint) (newmsgs 0)
X    (make-backup-files (and make-backup-files (buffer-modified-p)))
X    (buffer-read-only nil))
X    (or (setq insert-fn (get mail-drop 'insert-function))
X    (error "Missing transfer function for mail drop type %s" mail-drop))
X    (message "Checking %s..." mail-drop)
X    (setq tofile (funcall insert-fn mail-drop))
X    (cond ((and tofile (file-exists-p tofile))
X       (setq opoint (goto-char (point-max)))
X       (insert-file-contents tofile)
X       (goto-char (point-max))
X       (or (= (preceding-char) ?\n)
X           (= (preceding-char) ?\^_) ;no new mail although tofile exists
X           (insert ?\n))
X       (and (get mail-drop 'log-mail-drop)
X        (copy-file tofile
X               (expand-file-name (get mail-drop 'log-mail-drop)
X                         pcmail-directory) t))
X       (condition-case nil
X           (delete-file tofile)
X         (file-error nil))
X       (setq newmsgs
X         (pcmail-convert-region-to-babyl-format mail-drop opoint
X                            (point-max)))))
X    (message "Checking %s...done (%s new message%s)"
X         mail-drop (if (zerop newmsgs) "no" (int-to-string newmsgs))
X         (pcmail-s-ending newmsgs))))
X
X(provide 'pcmaildrop)
________This_Is_The_END________
if test `wc -c < pcmaildrop.el` -ne 4209; then
    echo 'shar: pcmaildrop.el was damaged during transit (should have been 4209 bytes)'
fi
fi        ; : end of overwriting check
exit 0